Usenet 1993 July

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1993 July / InfoMagic USENET CD-ROM July 1993.ISO / sources / misc / volume24 / gnucalc / part02 < prev next >

Wrap

Text File | 1991-10-28 | 55.5 KB | 1,700 lines

Newsgroups: comp.sources.misc From: daveg@synaptics.com (David Gillespie) Subject: v24i050: gnucalc - GNU Emacs Calculator, v2.00, Part02/56 Message-ID: <1991Oct29.040905.6697@sparky.imd.sterling.com> X-Md4-Signature: e69f6b6331e91b24e1bb9f2f24b27c57 Date: Tue, 29 Oct 1991 04:09:05 GMT Approved: kent@sparky.imd.sterling.com Submitted-by: daveg@synaptics.com (David Gillespie) Posting-number: Volume 24, Issue 50 Archive-name: gnucalc/part02 Environment: Emacs Supersedes: gmcalc: Volume 13, Issue 27-45 ---- Cut Here and unpack ---- #!/bin/sh # this is Part.02 (part 2 of a multipart archive) # do not concatenate these parts, unpack them in order with /bin/sh # file calc.el continued # if test ! -r _shar_seq_.tmp; then echo 'Please unpack part 1 first!' exit 1 fi (read Scheck if test "$Scheck" != 2; then echo Please unpack part "$Scheck" next! exit 1 else exit 0 fi ) < _shar_seq_.tmp || exit 1 if test ! -f _shar_wnt_.tmp; then echo 'x - still skipping calc.el' else echo 'x - continuing file calc.el' sed 's/^X//' << 'SHAR_EOF' >> 'calc.el' && X (put 'inexact-result 'error-message "Calc internal error (inexact-result)") X X ;; Define "math-overflow" and "math-underflow" as e-lisp error symbols. X (put 'math-overflow 'error-conditions '(error math-overflow calc-error)) X (put 'math-overflow 'error-message "Floating-point overflow occurred") X (put 'math-underflow 'error-conditions '(error math-underflow calc-error)) X (put 'math-underflow 'error-message "Floating-point underflow occurred") X X (setq calc-version "2.00" X calc-version-date "Sat Oct 26 17:36:38 PDT 1991" X calc-trail-pointer nil ; "Current" entry in trail buffer. X calc-trail-overlay nil ; Value of overlay-arrow-string. X calc-was-split nil ; Had multiple windows before Calc. X calc-undo-list nil ; List of previous operations for undo. X calc-redo-list nil ; List of recent undo operations. X calc-main-buffer nil ; Pointer to Calculator buffer. X calc-trail-buffer nil ; Pointer to Calc Trail buffer. X calc-why nil ; Explanations of most recent errors. X calc-next-why nil X calc-inverse-flag nil X calc-hyperbolic-flag nil X calc-keep-args-flag nil X calc-function-open "(" X calc-function-close ")" X calc-language-output-filter nil X calc-language-input-filter nil X calc-radix-formatter nil X calc-last-kill nil ; Last number killed in calc-mode. X calc-previous-alg-entry nil ; Previous algebraic entry. X calc-dollar-values nil ; Values to be used for '$'. X calc-dollar-used nil ; Highest order of '$' that occurred. X calc-hashes-used nil ; Highest order of '#' that occurred. X calc-quick-prev-results nil ; Previous results from Quick Calc. X calc-said-hello nil ; Has welcome message been said yet? X calc-executing-macro nil ; Kbd macro executing from "K" key. X calc-any-selections nil ; Nil means no selections present. X calc-help-phase 0 ; Count of consecutive "?" keystrokes. X calc-full-help-flag nil ; Executing calc-full-help? X calc-refresh-count 0 ; Count of calc-refresh calls. X calc-display-dirty nil X calc-prepared-composition nil X calc-selection-cache-default-entry nil X calc-embedded-info nil X calc-embedded-active nil X calc-standalone-flag nil X var-EvalRules nil X math-eval-rules-cache-tag t X math-radix-explicit-format t X math-expr-function-mapping nil X math-expr-variable-mapping nil X math-read-expr-quotes nil X math-working-step nil X math-working-step-2 nil X var-i '(special-const (math-imaginary 1)) X var-pi '(special-const (math-pi)) X var-e '(special-const (math-e)) X var-phi '(special-const (math-phi)) X var-gamma '(special-const (math-gamma-const))) X X (mapcar (function (lambda (v) (or (boundp (car v)) (set (car v) (nth 1 v))))) X calc-mode-var-list) X (mapcar (function (lambda (v) (or (boundp v) (set v nil)))) X calc-local-var-list) X X (if (boundp 'calc-mode-map) X nil X (setq calc-mode-map (make-keymap)) X (suppress-keymap calc-mode-map t) X (define-key calc-mode-map "+" 'calc-plus) X (define-key calc-mode-map "-" 'calc-minus) X (define-key calc-mode-map "*" 'calc-times) X (define-key calc-mode-map "/" 'calc-divide) X (define-key calc-mode-map "%" 'calc-mod) X (define-key calc-mode-map "&" 'calc-inv) X (define-key calc-mode-map "^" 'calc-power) X (define-key calc-mode-map "e" 'calcDigit-start) X (define-key calc-mode-map "i" 'calc-info) X (define-key calc-mode-map "n" 'calc-change-sign) X (define-key calc-mode-map "q" 'calc-quit) X (define-key calc-mode-map "Y" 'nil) X (define-key calc-mode-map "Y?" 'calc-shift-Y-prefix-help) X (define-key calc-mode-map "?" 'calc-help) X (define-key calc-mode-map " " 'calc-enter) X (define-key calc-mode-map "'" 'calc-algebraic-entry) X (define-key calc-mode-map "$" 'calc-auto-algebraic-entry) X (define-key calc-mode-map "\"" 'calc-auto-algebraic-entry) X (define-key calc-mode-map "\t" 'calc-roll-down) X (define-key calc-mode-map "\M-\t" 'calc-roll-up) X (define-key calc-mode-map "\C-m" 'calc-enter) X (define-key calc-mode-map "\M-\C-m" 'calc-last-args-stub) X (define-key calc-mode-map "\C-j" 'calc-over) X X (mapcar (function X (lambda (x) X (define-key calc-mode-map (char-to-string x) 'undefined))) X "lOW") X (mapcar (function X (lambda (x) X (define-key calc-mode-map (char-to-string x) X 'calc-missing-key))) X (concat "ABCDEFGHIJKLMNPQRSTUVXZabcdfghjkmoprstuvwxyz" X ":\\|!()[]<>{},;=~`\C-k\M-k\C-w\M-w\C-y\C-_")) X (mapcar (function X (lambda (x) X (define-key calc-mode-map (char-to-string x) 'calcDigit-start))) X "_0123456789.#@") X X (setq calc-digit-map (make-keymap)) X (let ((i 0)) X (while (< i 128) X (aset calc-digit-map i X (if (eq (aref calc-mode-map i) 'undefined) X 'undefined 'calcDigit-nondigit)) X (setq i (1+ i)))) X (mapcar (function X (lambda (x) X (define-key calc-digit-map (char-to-string x) X 'calcDigit-key))) X "_0123456789.e+-:n#@oh'\"mspM") X (mapcar (function X (lambda (x) X (define-key calc-digit-map (char-to-string x) X 'calcDigit-letter))) X "abcdfgijklqrtuvwxyzABCDEFGHIJKLNOPQRSTUVWXYZ") X (define-key calc-digit-map "'" 'calcDigit-algebraic) X (define-key calc-digit-map "`" 'calcDigit-edit) X (define-key calc-digit-map "\C-g" 'abort-recursive-edit) X X (mapcar (function X (lambda (x) X (condition-case err X (progn X (define-key calc-digit-map x 'calcDigit-backspace) X (define-key calc-mode-map x 'calc-pop) X (define-key calc-mode-map (concat "\e" x) X 'calc-pop-above)) X (error nil)))) X (if calc-scan-for-dels X (append (where-is-internal 'delete-backward-char global-map) X (where-is-internal 'backward-delete-char global-map) X '("\C-d")) X '("\177" "\C-d"))) X X (setq calc-dispatch-map (make-keymap)) X (calc-build-dispatch-map calc-dispatch-map) X (setq calc-dispatch-meta-map (make-sparse-keymap)) X (calc-build-dispatch-map calc-dispatch-meta-map) X (define-key calc-dispatch-map "\e" calc-dispatch-meta-map)) X X (autoload 'calc-extensions "calc-ext") X (autoload 'calc-need-macros "calc-macs") X ;;;; (Autoloads here) X (mapcar (function (lambda (x) X (mapcar (function (lambda (func) X (autoload func (car x)))) (cdr x)))) X '( X X ("calc-aent" calc-Need-calc-aent calc-alg-digit-entry calc-alg-entry calc-do-alg-entry calc-do-calc-eval calc-do-quick-calc math-read-expr-list math-read-exprs math-read-if math-read-token math-remove-dashes) X X ("calc-misc" calc-Need-calc-misc calc-delete-windows-keep calc-do-handle-whys calc-do-refresh calc-num-prefix-name calc-record-list calc-record-why calc-report-bug calc-roll-down-stack calc-roll-up-stack calc-temp-minibuffer-message calcFunc-floor calcFunc-inv calcFunc-trunc math-concat math-constp math-div2 math-div2-bignum math-do-working math-evenp math-fixnatnump math-fixnump math-floor math-imod math-ipow math-looks-negp math-mod math-negp math-posp math-pow math-read-radix-digit math-reject-arg math-trunc math-zerop) X )) X X (mapcar (function (lambda (x) X (mapcar (function (lambda (cmd) X (autoload cmd (car x) nil t))) (cdr x)))) X '( X X ("calc-aent" calc-algebraic-entry calc-auto-algebraic-entry calcDigit-algebraic calcDigit-edit) X X ("calc-misc" another-calc calc-big-or-small calc-dispatch-help calc-help calc-info calc-info-summary calc-inv calc-last-args-stub calc-missing-key calc-mod calc-other-window calc-over calc-pop-above calc-power calc-roll-down calc-roll-up calc-shift-Y-prefix-help calc-tutorial calcDigit-letter report-calc-bug) X )) X ) X ;;; (require 'calc-macs) X (defun calc-build-dispatch-map (map) X (mapcar (function X (lambda (x) X (define-key map (char-to-string (car x)) (cdr x)) X (define-key map (char-to-string (- (car x) ?a -1)) (cdr x)))) X '( ( ?a . calc-embedded-activate ) X ( ?b . calc-big-or-small ) X ( ?c . calc ) X ( ?d . calc-embedded-duplicate ) X ( ?e . calc-embedded ) X ( ?f . calc-embedded-new-formula ) X ( ?h . calc-dispatch-help ) X ( ?i . calc-info ) X ( ?j . calc-embedded-select ) X ( ?k . calc-keypad ) X ( ?l . calc-load-everything ) X ( ?n . calc-embedded-next ) X ( ?o . calc-other-window ) X ( ?p . calc-embedded-previous ) X ( ?q . quick-calc ) X ( ?r . calc-grab-rectangle ) X ( ?s . calc-info-summary ) X ( ?t . calc-tutorial ) X ( ?u . calc-embedded-update-formula ) X ( ?w . calc-embedded-word ) X ( ?x . calc-quit ) X ( ?y . calc-copy-to-buffer ) X ( ?z . calc-user-invocation ) )) X (define-key map "g" 'calc-grab-region) ; but not C-g! X (define-key map "m" 'read-kbd-macro) X (define-key map "=" 'calc-embedded-update-formula) X (define-key map "'" 'calc-embedded-new-formula) X (define-key map "`" 'calc-embedded-edit) X (define-key map ":" 'calc-grab-sum-down) X (define-key map "_" 'calc-grab-sum-across) X (define-key map "0" 'calc-reset) X (define-key map "#" 'calc-same-interface) X (define-key map "?" 'calc-dispatch-help) ) X (calc-init-base) X X ;;;###autoload (global-set-key "\e#" 'calc-dispatch) X ;;;###autoload (defun calc-dispatch (&optional arg) X "Invoke the GNU Emacs Calculator. See calc-dispatch-help for details." X (interactive "P") X (sit-for echo-keystrokes) X (condition-case err ; look for other keys bound to calc-dispatch X (let ((keys (this-command-keys))) X (or (string-match "\\`\C-u\\|\\`\e[-0-9#]\\|`[\M--\M-0-\M-9]" keys) X (eq (lookup-key calc-dispatch-map keys) 'calc-same-interface) X (progn X (and (string-match "\\`[\C-@-\C-_]" keys) X (symbolp X (lookup-key calc-dispatch-map (substring keys 0 1))) X (define-key calc-dispatch-map (substring keys 0 1) nil)) X (define-key calc-dispatch-map keys 'calc-same-interface)))) X (error nil)) X (calc-do-dispatch arg) ) X (defun calc-do-dispatch (arg) X (let ((key (calc-read-key-sequence X (if calc-dispatch-help X "Calc options: Calc, Keypad, Quick, Embed; eXit; Info, Tutorial; Grab; ?=more" X (format "%s (Type ? for a list of Calc options)" X (key-description (this-command-keys)))) X calc-dispatch-map))) X (setq key (lookup-key calc-dispatch-map key)) X (message "") X (if key X (progn X (or (commandp key) (calc-extensions)) X (call-interactively key)) X (beep))) ) (setq calc-dispatch-help nil) X (defun calc-read-key-sequence (prompt map) X (let ((prompt2 (format "%s " (key-description (this-command-keys)))) X (glob (current-global-map)) X (loc (current-local-map))) X (or (input-pending-p) (message prompt)) X (setq unread-command-char (read-char)) X (unwind-protect X (progn X (use-global-map map) X (use-local-map nil) X (read-key-sequence X (if (commandp (key-binding (char-to-string unread-command-char))) X "" prompt2))) X (use-global-map glob) X (use-local-map loc))) ) X X X (defun calc-mode () X "Calculator major mode. X This is an RPN calculator featuring arbitrary-precision integer, rational, floating-point, complex, matrix, and symbolic arithmetic. X RPN calculation: 2 RET 3 + produces 5. Algebraic style: ' 2+3 RET produces 5. X Basic operators are +, -, *, /, ^, & (reciprocal), % (modulo), n (change-sign). X Press ? repeatedly for more complete help. Press `h i' to read the Calc manual on-line, `h s' to read the summary, or `h t' for the tutorial. X Notations: 3.14e6 3.14 * 10^6 X _23 negative number -23 (or type `23 n') X 17:3 the fraction 17/3 X 5:2:3 the fraction 5 and 2/3 X 16#12C the integer 12C base 16 = 300 base 10 X 8#177:100 the fraction 177:100 base 8 = 127:64 base 10 X (2, 4) complex number 2 + 4i X (2; 4) polar complex number (r; theta) X [1, 2, 3] vector ([[1, 2], [3, 4]] is a matrix) X [1 .. 4) semi-open interval, 1 <= x < 4 X 2 +/- 3 (p key) number with mean 2, standard deviation 3 X 2 mod 3 (M key) number 2 computed modulo 3 X <1 jan 91> Date form (enter using ' key) X X \\{calc-mode-map} " X (interactive) X (mapcar (function X (lambda (v) (set-default v (symbol-value v)))) calc-local-var-list) X (kill-all-local-variables) X (use-local-map (if (eq calc-algebraic-mode 'total) X (progn (calc-extensions) calc-alg-map) calc-mode-map)) X (mapcar (function (lambda (v) (make-local-variable v))) calc-local-var-list) X (make-local-variable 'overlay-arrow-position) X (make-local-variable 'overlay-arrow-string) X (setq truncate-lines t) X (setq buffer-read-only t) X (setq major-mode 'calc-mode) X (setq mode-name "Calculator") X (setq calc-stack-top (length (or (memq (assq 'top-of-stack calc-stack) X calc-stack) X (setq calc-stack (list (list 'top-of-stack X 1 nil)))))) X (setq calc-stack-top (- (length calc-stack) calc-stack-top -1)) X (or calc-loaded-settings-file X (string-match "\\.emacs" calc-settings-file) X (progn X (setq calc-loaded-settings-file t) X (load calc-settings-file t))) ; t = missing-ok X (if (and (eq window-system 'x) (fboundp 'x-paste-text)) X (substitute-key-definition 'x-paste-text 'calc-x-paste-text X mouse-map)) X (let ((p command-line-args)) X (while p X (and (equal (car p) "-f") X (string-match "calc" (nth 1 p)) X (string-match "full" (nth 1 p)) X (setq calc-standalone-flag t)) X (setq p (cdr p)))) X (run-hooks 'calc-mode-hook) X (calc-refresh t) X (calc-set-mode-line) X ;; The calc-defs variable is a relic. Use calc-define properties instead. X (if (and (boundp 'calc-defs) X calc-defs) X (progn X (message "Evaluating calc-defs...") X (calc-need-macros) X (eval (cons 'progn calc-defs)) X (setq calc-defs nil) X (calc-set-mode-line))) X (calc-check-defines) ) X (defun calc-check-defines () X (if (symbol-plist 'calc-define) X (let ((plist (copy-sequence (symbol-plist 'calc-define)))) X (while (and plist (null (nth 1 plist))) X (setq plist (cdr (cdr plist)))) X (if plist X (save-excursion X (calc-extensions) X (calc-need-macros) X (set-buffer "*Calculator*") X (while plist X (put 'calc-define (car plist) nil) X (eval (nth 1 plist)) X (setq plist (cdr (cdr plist)))) X ;; See if this has added any more calc-define properties. X (calc-check-defines)) X (setplist 'calc-define nil)))) ) (setq calc-check-defines 'calc-check-defines) ; suitable for run-hooks X (defun calc-trail-mode (&optional buf) X "Calc Trail mode. This mode is used by the *Calc Trail* buffer, which records all results obtained by the GNU Emacs Calculator. X Calculator commands beginning with the `t' key are used to manipulate the Trail. X This buffer uses the same key map as the *Calculator* buffer; calculator commands given here will actually operate on the *Calculator* stack." X (interactive) X (fundamental-mode) X (use-local-map calc-mode-map) X (setq major-mode 'calc-trail-mode) X (setq mode-name "Calc Trail") X (setq truncate-lines t) X (setq buffer-read-only t) X (make-local-variable 'overlay-arrow-position) X (make-local-variable 'overlay-arrow-string) X (if buf X (progn X (make-local-variable 'calc-main-buffer) X (setq calc-main-buffer buf))) X (if (= (buffer-size) 0) X (let ((buffer-read-only nil)) X (insert "Emacs Calculator v" calc-version " by Dave Gillespie, " X "installed " calc-installed-date "\n"))) X (run-hooks 'calc-trail-mode-hook) ) X (defun calc-create-buffer () X (set-buffer (get-buffer-create "*Calculator*")) X (or (eq major-mode 'calc-mode) X (calc-mode)) X (setq max-lisp-eval-depth (max max-lisp-eval-depth 1000)) X (if calc-always-load-extensions X (calc-extensions)) X (if calc-language X (progn X (calc-extensions) X (calc-set-language calc-language calc-language-option t))) ) X ;;;###autoload (defun calc (&optional arg full-display interactive) X "The Emacs Calculator. Full documentation is listed under \"calc-mode\"." X (interactive "P") X (if arg X (or (eq arg 0) X (progn X (calc-extensions) X (if (= (prefix-numeric-value arg) -1) X (calc-grab-region (region-beginning) (region-end) nil) X (if (= (prefix-numeric-value arg) -2) X (calc-keypad))))) X (if (get-buffer-window "*Calc Keypad*") X (progn X (calc-keypad) X (set-buffer (window-buffer (selected-window))))) X (if (eq major-mode 'calc-mode) X (calc-quit) X (let ((oldbuf (current-buffer))) X (calc-create-buffer) X (setq calc-was-keypad-mode nil) X (if (or (eq full-display t) X (and (null full-display) calc-full-mode)) X (switch-to-buffer (current-buffer) t) X (if (get-buffer-window (current-buffer)) X (select-window (get-buffer-window (current-buffer))) X (setq calc-was-split nil) X (if (and (boundp 'calc-window-hook) calc-window-hook) X (run-hooks 'calc-window-hook) X (let ((w (get-largest-window))) X (if (and pop-up-windows X (> (window-height w) X (+ window-min-height calc-window-height 2))) X (progn X (or (one-window-p) X (setq calc-was-split (list w (window-height w) X (selected-window)))) X (setq w (split-window w X (- (window-height w) X calc-window-height 2) X nil)) X (set-window-buffer w (current-buffer)) X (select-window w)) X (pop-to-buffer (current-buffer))))))) X (save-excursion X (set-buffer (calc-trail-buffer)) X (and calc-display-trail X (= (window-width) (screen-width)) X (calc-trail-display 1 t))) X (message "Welcome to the GNU Emacs Calculator! Press `?' or `h' for help, `q' to quit.") X (run-hooks 'calc-start-hook) X (and (windowp full-display) X (window-point full-display) X (select-window full-display)) X (calc-check-defines) X (and calc-said-hello X (or (interactive-p) interactive) X (progn X (sit-for 2) X (message ""))) X (setq calc-said-hello t)))) ) X ;;;###autoload (defun full-calc () X "Invoke the Calculator and give it a full-sized window." X (interactive) X (calc nil t (interactive-p)) ) X (defun calc-same-interface (arg) X "Invoke the Calculator using the most recent interface (calc or calc-keypad)." X (interactive "P") X (if (and (equal (buffer-name) "*Gnuplot Trail*") X (> (recursion-depth) 0)) X (exit-recursive-edit) X (if (eq major-mode 'calc-edit-mode) X (calc-edit-finish arg) X (if (eq major-mode 'MacEdit-mode) X (MacEdit-finish-edit) X (if calc-was-keypad-mode X (calc-keypad) X (calc arg calc-full-mode t))))) ) X X (defun calc-quit (&optional non-fatal) X (interactive) X (and calc-standalone-flag (not non-fatal) X (save-buffers-kill-emacs nil)) X (if (and (equal (buffer-name) "*Gnuplot Trail*") X (> (recursion-depth) 0)) X (exit-recursive-edit)) X (if (eq major-mode 'calc-edit-mode) X (calc-edit-cancel) X (if (eq major-mode 'MacEdit-mode) X (MacEdit-cancel-edit) X (if (and (interactive-p) X calc-embedded-info X (eq (current-buffer) (aref calc-embedded-info 0))) X (calc-embedded nil) X (or (eq major-mode 'calc-mode) X (calc-create-buffer)) X (run-hooks 'calc-end-hook) X (setq calc-undo-list nil calc-redo-list nil) X (mapcar (function (lambda (v) (set-default v (symbol-value v)))) X calc-local-var-list) X (let ((buf (current-buffer)) X (win (get-buffer-window (current-buffer))) X (kbuf (get-buffer "*Calc Keypad*"))) X (delete-windows-on (calc-trail-buffer)) X (if (and win X (< (window-height win) (1- (screen-height))) X (= (window-width win) (screen-width)) ; avoid calc-keypad X (not (get-buffer-window "*Calc Keypad*"))) X (setq calc-window-height (- (window-height win) 2))) X (if calc-was-split X (calc-delete-windows-keep buf kbuf) X (delete-windows-on buf) X (delete-windows-on kbuf)) X (bury-buffer buf) X (bury-buffer calc-trail-buffer) X (and kbuf (bury-buffer kbuf)))))) ) X ;;;###autoload (defun quick-calc () X "Do a quick calculation in the minibuffer without invoking full Calculator." X (interactive) X (calc-do-quick-calc) ) X ;;;###autoload (defun calc-eval (str &optional separator &rest args) X "Do a quick calculation and return the result as a string. Return value will either be the formatted result in string form, or a list containing a character position and an error message in string form." X (calc-do-calc-eval str separator args) ) X ;;;###autoload (defun calc-keypad () X "Invoke the Calculator in \"visual keypad\" mode. This is most useful in the X window system. In this mode, click on the Calc \"buttons\" using the left mouse button. Or, position the cursor manually and do M-x calc-keypad-press." X (interactive) X (calc-extensions) X (calc-do-keypad calc-full-mode (interactive-p)) ) X ;;;###autoload (defun full-calc-keypad () X "Invoke the Calculator in full-screen \"visual keypad\" mode. See calc-keypad for details." X (interactive) X (calc-extensions) X (calc-do-keypad t (interactive-p)) ) X X ;;; Note that modifications to this function may break calc-pass-errors. (defun calc-do (do-body &optional do-slow) X (calc-check-defines) X (let* ((calc-command-flags nil) X (calc-start-time (and calc-timing (not calc-start-time) X (calc-extensions) X (current-time-string))) X (gc-cons-threshold (max gc-cons-threshold X (if calc-timing 2000000 100000)))) X (setq calc-aborted-prefix "") X (unwind-protect X (condition-case err X (save-excursion X (if calc-embedded-info X (calc-embedded-select-buffer) X (calc-select-buffer)) X (and (eq calc-algebraic-mode 'total) X (calc-extensions) X (use-local-map calc-alg-map)) X (and do-slow calc-display-working-message X (progn X (message "Working...") X (calc-set-command-flag 'clear-message))) X (funcall do-body) X (setq calc-aborted-prefix nil) X (and (memq 'renum-stack calc-command-flags) X (calc-renumber-stack)) X (and (memq 'clear-message calc-command-flags) X (message ""))) X (error X (if (and (eq (car err) 'error) X (stringp (nth 1 err)) X (string-match "max-specpdl-size\\|max-lisp-eval-depth" X (nth 1 err))) X (error "Computation got stuck or ran too long. Type `M' to increase the limit.") X (setq calc-aborted-prefix nil) X (signal (car err) (cdr err))))) X (setq calc-old-aborted-prefix calc-aborted-prefix) X (and calc-aborted-prefix X (calc-record "<Aborted>" calc-aborted-prefix)) X (and calc-start-time X (let* ((calc-internal-prec 12) X (calc-date-format nil) X (end-time (current-time-string)) X (time (if (equal calc-start-time end-time) X 0 X (math-sub X (calcFunc-unixtime (math-parse-date end-time) 0) X (calcFunc-unixtime (math-parse-date calc-start-time) X 0))))) X (if (math-lessp 1 time) X (calc-record time "(t)")))) X (or (memq 'no-align calc-command-flags) X (eq major-mode 'calc-trail-mode) X (calc-align-stack-window)) X (and (memq 'position-point calc-command-flags) X (if (eq major-mode 'calc-mode) X (progn X (goto-line calc-final-point-line) X (move-to-column calc-final-point-column)) X (save-excursion X (calc-select-buffer) X (goto-line calc-final-point-line) X (move-to-column calc-final-point-column)))) X (or (memq 'keep-flags calc-command-flags) X (save-excursion X (calc-select-buffer) X (setq calc-inverse-flag nil X calc-hyperbolic-flag nil X calc-keep-args-flag nil))) X (and (memq 'do-edit calc-command-flags) X (switch-to-buffer (get-buffer-create "*Calc Edit*"))) X (calc-set-mode-line) X (and calc-embedded-info X (calc-embedded-finish-command)))) X (identity nil) ; allow a GC after timing is done ) (setq calc-aborted-prefix nil) (setq calc-start-time nil) X (defun calc-set-command-flag (f) X (if (not (memq f calc-command-flags)) X (setq calc-command-flags (cons f calc-command-flags))) ) X (defun calc-select-buffer () X (or (eq major-mode 'calc-mode) X (if calc-main-buffer X (set-buffer calc-main-buffer) X (let ((buf (get-buffer "*Calculator*"))) X (if buf X (set-buffer buf) X (error "Calculator buffer not available"))))) ) X (defun calc-cursor-stack-index (&optional index) X (goto-char (point-max)) X (forward-line (- (calc-substack-height (or index 1)))) ) X (defun calc-stack-size () X (- (length calc-stack) calc-stack-top) ) X (defun calc-substack-height (n) X (let ((sum 0) X (stack calc-stack)) X (setq n (+ n calc-stack-top)) X (while (and (> n 0) stack) X (setq sum (+ sum (nth 1 (car stack))) X n (1- n) X stack (cdr stack))) X sum) ) X (defun calc-set-mode-line () X (save-excursion X (calc-select-buffer) X (let* ((fmt (car calc-float-format)) X (figs (nth 1 calc-float-format)) X (new-mode-string X (format "Calc%s%s: %d %s %-14s" X (if calc-embedded-info "Embed" "") X (if (and (> (length (buffer-name)) 12) X (equal (substring (buffer-name) 0 12) X "*Calculator*")) X (substring (buffer-name) 12) X "") X calc-internal-prec X (capitalize (symbol-name calc-angle-mode)) X (concat X X ;; Input-related modes X (if (eq calc-algebraic-mode 'total) "Alg* " X (if calc-algebraic-mode "Alg " X (if calc-incomplete-algebraic-mode "Alg[( " ""))) X X ;; Computational modes X (if calc-symbolic-mode "Symb " "") X (cond ((eq calc-matrix-mode 'matrix) "Matrix ") X ((integerp calc-matrix-mode) X (format "Matrix%d " calc-matrix-mode)) X ((eq calc-matrix-mode 'scalar) "Scalar ") X (t "")) X (if (eq calc-complex-mode 'polar) "Polar " "") X (if calc-prefer-frac "Frac " "") X (cond ((null calc-infinite-mode) "") X ((eq calc-infinite-mode 1) "+Inf ") X (t "Inf ")) X (cond ((eq calc-simplify-mode 'none) "NoSimp ") X ((eq calc-simplify-mode 'num) "NumSimp ") X ((eq calc-simplify-mode 'binary) X (format "BinSimp%d " calc-word-size)) X ((eq calc-simplify-mode 'alg) "AlgSimp ") X ((eq calc-simplify-mode 'ext) "ExtSimp ") X ((eq calc-simplify-mode 'units) "UnitSimp ") X (t "")) X X ;; Display modes X (cond ((= calc-number-radix 10) "") X ((= calc-number-radix 2) "Bin ") X ((= calc-number-radix 8) "Oct ") X ((= calc-number-radix 16) "Hex ") X (t (format "Radix%d " calc-number-radix))) X (if calc-leading-zeros "Zero " "") X (cond ((null calc-language) "") X ((eq calc-language 'tex) "TeX ") X (t (concat X (capitalize (symbol-name calc-language)) X " "))) X (cond ((eq fmt 'float) X (if (zerop figs) "" (format "Norm%d " figs))) X ((eq fmt 'fix) (format "Fix%d " figs)) X ((eq fmt 'sci) X (if (zerop figs) "Sci " (format "Sci%d " figs))) X ((eq fmt 'eng) X (if (zerop figs) "Eng " (format "Eng%d " figs)))) X (cond ((not calc-display-just) X (if calc-display-origin X (format "Left%d " calc-display-origin) "")) X ((eq calc-display-just 'right) X (if calc-display-origin X (format "Right%d " calc-display-origin) X "Right ")) X (t X (if calc-display-origin X (format "Center%d " calc-display-origin) X "Center "))) X (cond ((integerp calc-line-breaking) X (format "Wid%d " calc-line-breaking)) X (calc-line-breaking "") X (t "Wide ")) X X ;; Miscellaneous other modes/indicators X (if calc-assoc-selections "" "Break ") X (cond ((eq calc-mode-save-mode 'save) "Save ") X ((not calc-embedded-info) "") X ((eq calc-mode-save-mode 'local) "Local ") X ((eq calc-mode-save-mode 'edit) "LocEdit ") X ((eq calc-mode-save-mode 'perm) "LocPerm ") X ((eq calc-mode-save-mode 'global) "Global ") X (t "")) X (if calc-auto-recompute "" "Manual ") X (if (and (fboundp 'calc-gnuplot-alive) X (calc-gnuplot-alive)) "Graph " "") X (if (and calc-embedded-info X (> (calc-stack-size) 0) X (calc-top 1 'sel)) "Sel " "") X (if calc-display-dirty "Dirty " "") X (if calc-inverse-flag "Inv " "") X (if calc-hyperbolic-flag "Hyp " "") X (if calc-keep-args-flag "Keep " "") X (if (/= calc-stack-top 1) "Narrow " "") X (apply 'concat calc-other-modes))))) X (if (equal new-mode-string mode-line-buffer-identification) X nil X (setq mode-line-buffer-identification new-mode-string) X (set-buffer-modified-p (buffer-modified-p)) X (and calc-embedded-info (calc-embedded-mode-line-change))))) ) X (defun calc-align-stack-window () X (if (eq major-mode 'calc-mode) X (progn X (let ((win (get-buffer-window (current-buffer)))) X (if win X (progn X (calc-cursor-stack-index 0) X (vertical-motion (- 2 (window-height win))) X (set-window-start win (point))))) X (calc-cursor-stack-index 0) X (if (looking-at " *\\.$") X (goto-char (1- (match-end 0))))) X (save-excursion X (calc-select-buffer) X (calc-align-stack-window))) ) X (defun calc-check-stack (n) X (if (> n (calc-stack-size)) X (error "Too few elements on stack")) X (if (< n 0) X (error "Invalid argument")) ) X (defun calc-push-list (vals &optional m sels) X (while vals X (if calc-executing-macro X (calc-push-list-in-macro vals m sels) X (save-excursion X (calc-select-buffer) X (let* ((val (car vals)) X (entry (list val 1 (car sels))) X (mm (+ (or m 1) calc-stack-top))) X (calc-cursor-stack-index (1- (or m 1))) X (if (> mm 1) X (setcdr (nthcdr (- mm 2) calc-stack) X (cons entry (nthcdr (1- mm) calc-stack))) X (setq calc-stack (cons entry calc-stack))) X (let ((buffer-read-only nil)) X (insert (math-format-stack-value entry) "\n")) X (calc-record-undo (list 'push mm)) X (calc-set-command-flag 'renum-stack)))) X (setq vals (cdr vals) X sels (cdr sels))) ) X (defun calc-pop-push-list (n vals &optional m sels) X (if (and calc-any-selections (null sels)) X (calc-replace-selections n vals m) X (calc-pop-stack n m sels) X (calc-push-list vals m sels)) ) X (defun calc-pop-push-record-list (n prefix vals &optional m sels) X (or (and (consp vals) X (or (integerp (car vals)) X (consp (car vals)))) X (and vals (setq vals (list vals) X sels (and sels (list sels))))) X (calc-check-stack (+ n (or m 1) -1)) X (if prefix X (if (cdr vals) X (calc-record-list vals prefix) X (calc-record (car vals) prefix))) X (calc-pop-push-list n vals m sels) ) X (defun calc-enter-result (n prefix vals &optional m) X (setq calc-aborted-prefix prefix) X (if (and (consp vals) X (or (integerp (car vals)) X (consp (car vals)))) X (setq vals (mapcar 'calc-normalize vals)) X (setq vals (calc-normalize vals))) X (or (and (consp vals) X (or (integerp (car vals)) X (consp (car vals)))) X (setq vals (list vals))) X (if (equal vals '((nil))) X (setq vals nil)) X (calc-pop-push-record-list n prefix vals m) X (calc-handle-whys) ) X (defun calc-normalize (val) X (if (memq calc-simplify-mode '(nil none num)) X (math-normalize val) X (calc-extensions) X (calc-normalize-fancy val)) ) X (defun calc-handle-whys () X (if calc-next-why X (calc-do-handle-whys)) ) X X (defun calc-pop-stack (&optional n m sel-ok) ; pop N objs at level M of stack. X (or n (setq n 1)) X (or m (setq m 1)) X (or calc-keep-args-flag X (let ((mm (+ m calc-stack-top))) X (if (and calc-any-selections (not sel-ok) X (calc-top-selected n m)) X (calc-sel-error)) X (if calc-executing-macro X (calc-pop-stack-in-macro n mm) X (calc-record-undo (list 'pop mm (calc-top-list n m 'full))) X (save-excursion X (calc-select-buffer) X (let ((buffer-read-only nil)) X (if (> mm 1) X (progn X (calc-cursor-stack-index (1- m)) X (let ((bot (point))) X (calc-cursor-stack-index (+ n m -1)) X (delete-region (point) bot)) X (setcdr (nthcdr (- mm 2) calc-stack) X (nthcdr (+ n mm -1) calc-stack))) X (calc-cursor-stack-index n) X (setq calc-stack (nthcdr n calc-stack)) X (delete-region (point) (point-max)))) X (calc-set-command-flag 'renum-stack))))) ) X (defun calc-get-stack-element (x) X (cond ((eq sel-mode 'entry) X x) X ((eq sel-mode 'sel) X (nth 2 x)) X ((or (null (nth 2 x)) X (eq sel-mode 'full) X (not calc-use-selections)) X (car x)) X (sel-mode X (calc-sel-error)) X (t (nth 2 x))) ) X ;; Get the Nth element of the stack (N=1 is the top element). (defun calc-top (&optional n sel-mode) X (or n (setq n 1)) X (calc-check-stack n) X (calc-get-stack-element (nth (+ n calc-stack-top -1) calc-stack)) ) X (defun calc-top-n (&optional n sel-mode) ; in case precision has changed X (math-check-complete (calc-normalize (calc-top n sel-mode))) ) X (defun calc-top-list (&optional n m sel-mode) X (or n (setq n 1)) X (or m (setq m 1)) X (calc-check-stack (+ n m -1)) X (and (> n 0) X (let ((top (copy-sequence (nthcdr (+ m calc-stack-top -1) X calc-stack)))) X (setcdr (nthcdr (1- n) top) nil) X (nreverse (mapcar 'calc-get-stack-element top)))) ) X (defun calc-top-list-n (&optional n m sel-mode) X (mapcar 'math-check-complete X (mapcar 'calc-normalize (calc-top-list n m sel-mode))) ) X X (defun calc-renumber-stack () X (if calc-line-numbering X (save-excursion X (calc-cursor-stack-index 0) X (let ((lnum 1) X (buffer-read-only nil) X (stack (nthcdr calc-stack-top calc-stack))) X (if (re-search-forward "^[0-9]+[:*]" nil t) X (progn X (beginning-of-line) X (while (re-search-forward "^[0-9]+[:*]" nil t) X (let ((buffer-read-only nil)) X (beginning-of-line) X (delete-char 4) X (insert " "))) X (calc-cursor-stack-index 0))) X (while (re-search-backward "^[0-9]+[:*]" nil t) X (delete-char 4) X (if (> lnum 999) X (insert (format "%03d%s" (% lnum 1000) X (if (and (nth 2 (car stack)) X calc-use-selections) "*" ":"))) X (let ((prefix (int-to-string lnum))) X (insert prefix (if (and (nth 2 (car stack)) X calc-use-selections) "*" ":") X (make-string (- 3 (length prefix)) 32)))) X (beginning-of-line) X (setq lnum (1+ lnum) X stack (cdr stack)))))) X (and calc-embedded-info (calc-embedded-stack-change)) ) X (defun calc-refresh (&optional align) X (interactive) X (and (eq major-mode 'calc-mode) X (not calc-executing-macro) X (let ((buffer-read-only nil) X (save-point (point)) X (save-mark (mark)) X (save-aligned (looking-at "\\.$")) X (thing calc-stack)) X (setq calc-any-selections nil X calc-any-evaltos nil) X (erase-buffer) X (insert "--- Emacs Calculator Mode ---\n") X (while thing X (goto-char (point-min)) X (forward-line 1) X (insert (math-format-stack-value (car thing)) "\n") X (setq thing (cdr thing))) X (calc-renumber-stack) X (if calc-display-dirty X (calc-wrapper (setq calc-display-dirty nil))) X (and calc-any-evaltos calc-auto-recompute X (calc-wrapper (calc-refresh-evaltos))) X (if (or align save-aligned) X (calc-align-stack-window) X (goto-char save-point)) X (set-mark save-mark))) X (and calc-embedded-info (not (eq major-mode 'calc-mode)) X (save-excursion X (set-buffer (aref calc-embedded-info 1)) X (calc-refresh align))) X (setq calc-refresh-count (1+ calc-refresh-count)) ) X X (defun calc-x-paste-text (arg) X "Move point to mouse position and insert window system cut buffer contents. If mouse is pressed in Calc window, push cut buffer contents onto the stack." X (x-mouse-select arg) X (if (memq major-mode '(calc-mode calc-trail-mode)) X (progn X (calc-wrapper X (calc-extensions) X (let* ((buf (x-get-cut-buffer)) X (val (math-read-exprs (calc-clean-newlines buf)))) X (if (eq (car-safe val) 'error) X (progn X (setq val (math-read-exprs buf)) X (if (eq (car-safe val) 'error) X (error "%s in yanked data" (nth 2 val))))) X (calc-enter-result 0 "Xynk" val)))) X (x-paste-text arg)) ) X X X ;;;; The Calc Trail buffer. X (defun calc-check-trail-aligned () X (save-excursion X (let ((win (get-buffer-window (current-buffer)))) X (and win X (pos-visible-in-window-p (1- (point-max)) win)))) ) X (defun calc-trail-buffer () X (and (or (null calc-trail-buffer) X (null (buffer-name calc-trail-buffer))) X (save-excursion X (setq calc-trail-buffer (get-buffer-create "*Calc Trail*")) X (let ((buf (or (and (not (eq major-mode 'calc-mode)) X (get-buffer "*Calculator*")) X (current-buffer)))) X (set-buffer calc-trail-buffer) X (or (eq major-mode 'calc-trail-mode) X (calc-trail-mode buf))))) X (or (and calc-trail-pointer X (eq (marker-buffer calc-trail-pointer) calc-trail-buffer)) X (save-excursion X (set-buffer calc-trail-buffer) X (goto-line 2) X (setq calc-trail-pointer (point-marker)))) X calc-trail-buffer ) X (defun calc-record (val &optional prefix) X (setq calc-aborted-prefix nil) X (or calc-executing-macro X (let* ((mainbuf (current-buffer)) X (buf (calc-trail-buffer)) X (calc-display-raw nil) X (calc-can-abbrev-vectors t) X (fval (if val X (if (stringp val) X val X (math-showing-full-precision X (math-format-flat-expr val 0))) X ""))) X (save-excursion X (set-buffer buf) X (let ((aligned (calc-check-trail-aligned)) X (buffer-read-only nil)) X (goto-char (point-max)) X (cond ((null prefix) (insert " ")) X ((and (> (length prefix) 4) X (string-match " " prefix 4)) X (insert (substring prefix 0 4) " ")) X (t (insert (format "%4s " prefix)))) X (insert fval "\n") X (let ((win (get-buffer-window buf))) X (if (and aligned win (not (memq 'hold-trail calc-command-flags))) X (calc-trail-here)) X (goto-char (1- (point-max)))))))) X val ) X X (defun calc-trail-display (flag &optional no-refresh) X (interactive "P") X (let ((win (get-buffer-window (calc-trail-buffer)))) X (if (setq calc-display-trail X (not (if flag (memq flag '(nil 0)) win))) X (if (null win) X (progn X (if (and (boundp 'calc-trail-window-hook) calc-trail-window-hook) X (run-hooks 'calc-trail-window-hook) X (let ((w (split-window nil (/ (* (window-width) 2) 3) t))) X (set-window-buffer w calc-trail-buffer))) X (calc-wrapper X (setq overlay-arrow-string calc-trail-overlay X overlay-arrow-position calc-trail-pointer) X (or no-refresh X (if (interactive-p) X (calc-do-refresh) X (calc-refresh)))))) X (if win X (progn X (delete-window win) X (calc-wrapper X (or no-refresh X (if (interactive-p) X (calc-do-refresh) X (calc-refresh)))))))) X calc-trail-buffer ) X (defun calc-trail-here () X (interactive) X (if (eq major-mode 'calc-trail-mode) X (progn X (beginning-of-line) X (if (bobp) X (forward-line 1) X (if (eobp) X (forward-line -1))) X (if (or (bobp) (eobp)) X (setq overlay-arrow-position nil) ; trail is empty X (set-marker calc-trail-pointer (point) (current-buffer)) X (setq calc-trail-overlay (concat (buffer-substring (point) X (+ (point) 4)) X ">") X overlay-arrow-string calc-trail-overlay X overlay-arrow-position calc-trail-pointer) X (forward-char 4) X (let ((win (get-buffer-window (current-buffer)))) X (if win X (save-excursion X (forward-line (/ (window-height win) 2)) X (forward-line (- 1 (window-height win))) X (set-window-start win (point)) X (set-window-point win (+ calc-trail-pointer 4)) X (set-buffer calc-main-buffer) X (setq overlay-arrow-string calc-trail-overlay X overlay-arrow-position calc-trail-pointer)))))) X (error "Not in Calc Trail buffer")) ) X X X X ;;;; The Undo list. X (defun calc-record-undo (rec) X (or calc-executing-macro X (if (memq 'undo calc-command-flags) X (setq calc-undo-list (cons (cons rec (car calc-undo-list)) X (cdr calc-undo-list))) X (setq calc-undo-list (cons (list rec) calc-undo-list) X calc-redo-list nil) X (calc-set-command-flag 'undo))) ) X X X X ;;; Arithmetic commands. X (defun calc-binary-op (name func arg &optional ident unary func2) X (setq calc-aborted-prefix name) X (if (null arg) X (calc-enter-result 2 name (cons (or func2 func) X (mapcar 'math-check-complete X (calc-top-list 2)))) X (calc-extensions) X (calc-binary-op-fancy name func arg ident unary)) ) X (defun calc-unary-op (name func arg &optional func2) X (setq calc-aborted-prefix name) X (if (null arg) X (calc-enter-result 1 name (list (or func2 func) X (math-check-complete (calc-top 1)))) X (calc-extensions) X (calc-unary-op-fancy name func arg)) ) X X (defun calc-plus (arg) X (interactive "P") X (calc-slow-wrapper X (calc-binary-op "+" 'calcFunc-add arg 0 nil '+)) ) X (defun calc-minus (arg) X (interactive "P") X (calc-slow-wrapper X (calc-binary-op "-" 'calcFunc-sub arg 0 'neg '-)) ) X (defun calc-times (arg) X (interactive "P") X (calc-slow-wrapper X (calc-binary-op "*" 'calcFunc-mul arg 1 nil '*)) ) X (defun calc-divide (arg) X (interactive "P") X (calc-slow-wrapper X (calc-binary-op "/" 'calcFunc-div arg 0 'calcFunc-inv '/)) ) X X (defun calc-change-sign (arg) X (interactive "P") X (calc-wrapper X (calc-unary-op "chs" 'neg arg)) ) X X X ;;; Stack management commands. X (defun calc-enter (n) X (interactive "p") X (calc-wrapper X (cond ((< n 0) X (calc-push-list (calc-top-list 1 (- n)))) X ((= n 0) X (calc-push-list (calc-top-list (calc-stack-size)))) X (t X (calc-push-list (calc-top-list n))))) ) X X (defun calc-pop (n) X (interactive "P") X (calc-wrapper X (let* ((nn (prefix-numeric-value n)) X (top (and (null n) (calc-top 1)))) X (cond ((and (null n) X (eq (car-safe top) 'incomplete) X (> (length top) (if (eq (nth 1 top) 'intv) 3 2))) X (calc-pop-push-list 1 (let ((tt (copy-sequence top))) X (setcdr (nthcdr (- (length tt) 2) tt) nil) X (list tt)))) X ((< nn 0) X (if (and calc-any-selections X (calc-top-selected 1 (- nn))) X (calc-delete-selection (- nn)) X (calc-pop-stack 1 (- nn) t))) X ((= nn 0) X (calc-pop-stack (calc-stack-size) 1 t)) X (t X (if (and calc-any-selections X (= nn 1) X (calc-top-selected 1 1)) X (calc-delete-selection 1) X (calc-pop-stack nn)))))) ) X X X X ;;;; Reading a number using the minibuffer. X (defun calcDigit-start () X (interactive) X (calc-wrapper X (if (or calc-algebraic-mode X (and (> calc-number-radix 14) (eq last-command-char ?e))) X (calc-alg-digit-entry) X (setq unread-command-char last-command-char X calc-aborted-prefix nil) X (let* ((calc-digit-value nil) X (calc-prev-char nil) X (calc-prev-prev-char nil) X (calc-buffer (current-buffer)) X (buf (read-from-minibuffer "Calc: " "" calc-digit-map))) X (or calc-digit-value (setq calc-digit-value (math-read-number buf))) X (if (stringp calc-digit-value) X (calc-alg-entry calc-digit-value) X (if calc-digit-value X (calc-push-list (list (calc-record (calc-normalize X calc-digit-value)))))) X (if (eq calc-prev-char 'dots) X (progn X (calc-extensions) X (calc-dots)))))) ) X (defun calcDigit-nondigit () X (interactive) X ;; Exercise for the reader: Figure out why this is a good precaution! X (or (boundp 'calc-buffer) X (use-local-map minibuffer-local-map)) X (let ((str (buffer-string))) X (setq calc-digit-value (save-excursion X (set-buffer calc-buffer) X (math-read-number str)))) X (if (and (null calc-digit-value) (> (buffer-size) 0)) X (progn X (beep) X (calc-temp-minibuffer-message " [Bad format]")) X (or (memq last-command-char '(32 13)) X (setq prefix-arg current-prefix-arg X unread-command-char last-command-char)) X (exit-minibuffer)) ) X X (defun calc-minibuffer-contains (rex) X (save-excursion X (goto-char (point-min)) X (looking-at rex)) ) X (defun calcDigit-key () X (interactive) X (goto-char (point-max)) X (if (or (and (memq last-command-char '(?+ ?-)) X (> (buffer-size) 0) X (/= (preceding-char) ?e)) X (and (memq last-command-char '(?m ?s)) X (not (calc-minibuffer-contains "[-+]?[0-9]+\\.?0*[@oh].*")) X (not (calc-minibuffer-contains "[-+]?\$1[1-9]\\|[2-9][0-9]\$#.*")))) X (calcDigit-nondigit) X (if (calc-minibuffer-contains "\$[-+]?\\|.* \$\\'") X (cond ((memq last-command-char '(?. ?@)) (insert "0")) X ((and (memq last-command-char '(?o ?h ?m)) X (not (calc-minibuffer-contains ".*#.*"))) (insert "0")) X ((memq last-command-char '(?: ?e)) (insert "1")) X ((eq last-command-char ?#) X (insert (int-to-string calc-number-radix))))) X (if (and (calc-minibuffer-contains "\$[-+]?[0-9]+#\\|[^:]*:\$\\'") X (eq last-command-char ?:)) X (insert "1")) X (if (and (calc-minibuffer-contains "[-+]?[0-9]+#\\'") X (eq last-command-char ?.)) X (insert "0")) X (if (and (calc-minibuffer-contains "[-+]?0*\$[2-9]\\|1[0-4]\$#\\'") X (eq last-command-char ?e)) X (insert "1")) X (if (or (and (memq last-command-char '(?h ?o ?m ?s ?p)) X (calc-minibuffer-contains ".*#.*")) X (and (eq last-command-char ?e) X (calc-minibuffer-contains "[-+]?\$1[5-9]\\|[2-9][0-9]\$#.*")) X (and (eq last-command-char ?n) X (calc-minibuffer-contains "[-+]?\$2[4-9]\\|[3-9][0-9]\$#.*"))) X (setq last-command-char (upcase last-command-char))) X (cond X ((memq last-command-char '(?_ ?n)) X (goto-char (point-min)) X (if (and (search-forward " +/- " nil t) X (not (search-forward "e" nil t))) X (beep) X (and (not (calc-minibuffer-contains "[-+]?\$1[5-9]\\|[2-9][0-9]\$#.*")) X (search-forward "e" nil t)) X (if (looking-at "+") X (delete-char 1)) X (if (looking-at "-") X (delete-char 1) X (insert "-"))) X (goto-char (point-max))) X ((eq last-command-char ?p) X (if (or (calc-minibuffer-contains ".*\\+/-.*") X (calc-minibuffer-contains ".*mod.*") X (calc-minibuffer-contains ".*#.*") X (calc-minibuffer-contains ".*[-+e:]\\'")) X (beep) X (if (not (calc-minibuffer-contains ".* \\'")) X (insert " ")) X (insert "+/- "))) X ((and (eq last-command-char ?M) X (not (calc-minibuffer-contains X "[-+]?\$2[3-9]\\|[3-9][0-9]\$#.*"))) X (if (or (calc-minibuffer-contains ".*\\+/-.*") X (calc-minibuffer-contains ".*mod *[^ ]+") X (calc-minibuffer-contains ".*[-+e:]\\'")) X (beep) X (if (calc-minibuffer-contains ".*mod \\'") X (if calc-previous-modulo X (insert (math-format-flat-expr calc-previous-modulo 0)) X (beep)) X (if (not (calc-minibuffer-contains ".* \\'")) X (insert " ")) X (insert "mod ")))) X (t X (insert (char-to-string last-command-char)) X (if (or (and (calc-minibuffer-contains "[-+]?\$.*\\+/- *\\|.*mod *\$?\$[0-9][0-9]?\$#[0-9a-zA-Z]*\$:[0-9a-zA-Z]*\\(:[0-9a-zA-Z]*\$?\\|.[0-9a-zA-Z]*\$e[-+]?[0-9]*\$?\\)?\\'") X (let ((radix (string-to-int X (buffer-substring X (match-beginning 2) (match-end 2))))) X (and (>= radix 2) X (<= radix 36) X (or (memq last-command-char '(?# ?: ?. ?e ?+ ?-)) X (let ((dig (math-read-radix-digit X (upcase last-command-char)))) X (and dig X (< dig radix))))))) X (save-excursion X (goto-char (point-min)) X (looking-at X "[-+]?\$.*\\+/- *\\|.*mod *\$?\$[0-9]+\\.?0*[@oh] *\$?\$[0-9]+\\.?0*['m] *\$?[0-9]*\$\\.?[0-9]*\\(e[-+]?[0-3]?[0-9]?[0-9]?[0-9]?[0-9]?[0-9]?[0-9]?\$?\\|[0-9]:\$[0-9]+:\$?[0-9]*\\)?[\"s]?\\'"))) X (if (and (memq last-command-char '(?@ ?o ?h ?\' ?m)) X (string-match " " calc-hms-format)) X (insert " ")) X (if (and (eq this-command last-command) X (eq last-command-char ?.)) X (progn X (calc-extensions) X (calc-digit-dots)) X (delete-backward-char 1) X (beep) X (calc-temp-minibuffer-message " [Bad format]")))))) X (setq calc-prev-prev-char calc-prev-char X calc-prev-char last-command-char) ) X X (defun calcDigit-backspace () X (interactive) X (goto-char (point-max)) X (cond ((calc-minibuffer-contains ".* \\+/- \\'") X (backward-delete-char 5)) X ((calc-minibuffer-contains ".* mod \\'") X (backward-delete-char 5)) X ((calc-minibuffer-contains ".* \\'") X (backward-delete-char 2)) X ((eq last-command 'calcDigit-start) X (erase-buffer)) X (t (backward-delete-char 1))) X (if (= (buffer-size) 0) X (progn X (setq last-command-char 13) X (calcDigit-nondigit))) ) X X X X X X X ;;;; Arithmetic routines. ;;; ;;; An object as manipulated by one of these routines may take any of the ;;; following forms: ;;; ;;; integer An integer. For normalized numbers, this format ;;; is used only for -999999 ... 999999. ;;; ;;; (bigpos N0 N1 N2 ...) A big positive integer, N0 + N1*1000 + N2*10^6 ... ;;; (bigneg N0 N1 N2 ...) A big negative integer, - N0 - N1*1000 ... ;;; Each digit N is in the range 0 ... 999. ;;; Normalized, always at least three N present, ;;; and the most significant N is nonzero. ;;; ;;; (frac NUM DEN) A fraction. NUM and DEN are small or big integers. ;;; Normalized, DEN > 1. ;;; ;;; (float NUM EXP) A floating-point number, NUM * 10^EXP; ;;; NUM is a small or big integer, EXP is a small int. ;;; Normalized, NUM is not a multiple of 10, and ;;; abs(NUM) < 10^calc-internal-prec. ;;; Normalized zero is stored as (float 0 0). ;;; ;;; (cplx REAL IMAG) A complex number; REAL and IMAG are any of above. ;;; Normalized, IMAG is nonzero. ;;; ;;; (polar R THETA) Polar complex number. Normalized, R > 0 and THETA ;;; is neither zero nor 180 degrees (pi radians). ;;; ;;; (vec A B C ...) Vector of objects A, B, C, ... A matrix is a ;;; vector of vectors. ;;; ;;; (hms H M S) Angle in hours-minutes-seconds form. All three ;;; components have the same sign; H and M must be ;;; numerically integers; M and S are expected to ;;; lie in the range [0,60). ;;; ;;; (date N) A date or date/time object. N is an integer to ;;; store a date only, or a fraction or float to ;;; store a date and time. ;;; ;;; (sdev X SIGMA) Error form, X +/- SIGMA. When normalized, ;;; SIGMA > 0. X is any complex number and SIGMA ;;; is real numbers; or these may be symbolic ;;; expressions where SIGMA is assumed real. ;;; ;;; (intv MASK LO HI) Interval form. MASK is 0=(), 1=(], 2=[), or 3=[]. ;;; LO and HI are any real numbers, or symbolic ;;; expressions which are assumed real, and LO < HI. ;;; For [LO..HI], if LO = HI normalization produces LO, ;;; and if LO > HI normalization produces [LO..LO). ;;; For other intervals, if LO > HI normalization ;;; sets HI equal to LO. ;;; ;;; (mod N M) Number modulo M. When normalized, 0 <= N < M. ;;; N and M are real numbers. ;;; ;;; (var V S) Symbolic variable. V is a Lisp symbol which ;;; represents the variable's visible name. S is ;;; the symbol which actually stores the variable's ;;; value: (var pi var-pi). ;;; ;;; In general, combining rational numbers in a calculation always produces ;;; a rational result, but if either argument is a float, result is a float. X ;;; In the following comments, [x y z] means result is x, args must be y, z, ;;; respectively, where the code letters are: ;;; ;;; O Normalized object (vector or number) ;;; V Normalized vector ;;; N Normalized number of any type ;;; N Normalized complex number ;;; R Normalized real number (float or rational) ;;; F Normalized floating-point number ;;; T Normalized rational number ;;; I Normalized integer ;;; B Normalized big integer ;;; S Normalized small integer ;;; D Digit (small integer, 0..999) ;;; L Normalized bignum digit list (without "bigpos" or "bigneg" symbol) ;;; or normalized vector element list (without "vec") ;;; P Predicate (truth value) ;;; X Any Lisp object ;;; Z "nil" ;;; ;;; Lower-case letters signify possibly un-normalized values. ;;; "L.D" means a cons of an L and a D. ;;; [N N; n n] means result will be normalized if argument is. ;;; Also, [Public] marks routines intended to be called from outside. ;;; [This notation has been neglected in many recent routines.] X ;;; Reduce an object to canonical (normalized) form. [O o; Z Z] [Public] (defun math-normalize (a) X (cond X ((not (consp a)) X (if (integerp a) X (if (or (>= a 1000000) (<= a -1000000)) X (math-bignum a) X a) X a)) X ((eq (car a) 'bigpos) X (if (eq (nth (1- (length a)) a) 0) X (let* ((last (setq a (copy-sequence a))) (digs a)) X (while (setq digs (cdr digs)) X (or (eq (car digs) 0) (setq last digs))) X (setcdr last nil))) X (if (cdr (cdr (cdr a))) X a X (cond X ((cdr (cdr a)) (+ (nth 1 a) (* (nth 2 a) 1000))) X ((cdr a) (nth 1 a)) X (t 0)))) X ((eq (car a) 'bigneg) X (if (eq (nth (1- (length a)) a) 0) X (let* ((last (setq a (copy-sequence a))) (digs a)) X (while (setq digs (cdr digs)) X (or (eq (car digs) 0) (setq last digs))) X (setcdr last nil))) X (if (cdr (cdr (cdr a))) X a X (cond X ((cdr (cdr a)) (- (+ (nth 1 a) (* (nth 2 a) 1000)))) X ((cdr a) (- (nth 1 a))) X (t 0)))) X ((eq (car a) 'float) X (math-make-float (math-normalize (nth 1 a)) (nth 2 a))) X ((or (memq (car a) '(frac cplx polar hms date mod sdev intv vec var quote X special-const calcFunc-if calcFunc-lambda X calcFunc-quote calcFunc-condition X calcFunc-evalto)) X (integerp (car a)) X (and (consp (car a)) (not (eq (car (car a)) 'lambda)))) X (calc-extensions) X (math-normalize-fancy a)) X (t X (or (and calc-simplify-mode X (calc-extensions) X (math-normalize-nonstandard)) X (let ((args (mapcar 'math-normalize (cdr a)))) X (or (condition-case err X (let ((func (assq (car a) '( ( + . math-add ) X ( - . math-sub ) X ( * . math-mul ) X ( / . math-div ) X ( % . math-mod ) X ( ^ . math-pow ) X ( neg . math-neg ) X ( | . math-concat ) )))) X (or (and var-EvalRules X (progn X (or (eq var-EvalRules math-eval-rules-cache-tag) X (progn X (calc-extensions) X (math-recompile-eval-rules))) X (and (or math-eval-rules-cache-other X (assq (car a) math-eval-rules-cache)) X (math-apply-rewrites X (cons (car a) args) SHAR_EOF true || echo 'restore of calc.el failed' fi echo 'End of part 2' echo 'File calc.el is continued in part 3' echo 3 > _shar_seq_.tmp exit 0 exit 0 # Just in case... -- Kent Landfield INTERNET: kent@sparky.IMD.Sterling.COM Sterling Software, IMD UUCP: uunet!sparky!kent Phone: (402) 291-8300 FAX: (402) 291-4362 Please send comp.sources.misc-related mail to kent@uunet.uu.net.